!======================================================================
!
!    HEEDS (Higher Education Enrollment Decision Support) - A program
!      to create enrollment scenarios for 'next term' in a university
!    Copyright (C) 2012, 2013 Ricolindo L Carino
!
!    This file is part of the HEEDS program.
!
!    HEEDS is free software: you can redistribute it and/or modify
!    it under the terms of the GNU General Public License as published by
!    the Free Software Foundation, either version 3 of the License, or
!    (at your option) any later version.
!
!    HEEDS is distributed in the hope that it will be useful,
!    but WITHOUT ANY WARRANTY; without even the implied warranty of
!    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!    GNU General Public License for more details.
!
!    You should have received a copy of the GNU General Public License
!    along with this program (see the file COPYING.TXT). If not, see
!    <http://www.gnu.org/licenses/>.
!
!    Send inquiries about HEEDS to:
!      Ricolindo L Carino
!      E-mail: Ricolindo.Carino@AcademicForecasts.com
!      Address: 600 Cruise St., Starkville, MS 39759, U.S.A.
!
!======================================================================


module PRE_ENLISTMENT

    use SECTIONS
    USE STUDENTS
    use GRADES

    implicit none

    type :: TYPE_PRE_ENLISTMENT
        integer :: UnitsEarned, StdClassification, StdYear, AllowedLoad, StdPriority, &
        lenSubject, NPriority, NAlternates, NCurrent
        integer, dimension(MAX_SUBJECTS_PER_TERM) :: Subject, Section, Grade
        real, dimension(MAX_SUBJECTS_PER_TERM) :: Contrib
    end type TYPE_PRE_ENLISTMENT
    type (TYPE_PRE_ENLISTMENT), dimension(0:MAX_ALL_STUDENTS) :: Preenlisted, Advised

    logical :: isDirtyPREDICTIONS = .false.
    integer :: NumPredictionRecords
    integer :: NumEnlistmentRecords


    ! private tokens
    character (len=MAX_LEN_FILE_PATH), private :: fileName
    character (len=MAX_LEN_XML_LINE), private :: line
    integer, private :: unitNo=2, eof, ndels, pos(60)


contains


    subroutine recalculate_available_seats(Section)
        type (TYPE_SECTION), intent(in out), dimension (0:) :: Section
        integer :: i, j, std
        ! calculate priority demand, priority accomodated/not accommodated
        Section(:)%RemSlots = Section(:)%Slots
        do std = 1,NumStudents
            do i=1,Preenlisted(std)%NPriority+Preenlisted(std)%NAlternates+Preenlisted(std)%NCurrent
                j = Preenlisted(std)%Section(i)
                if (j > 0) then ! accommodated or force enlisted
                    Section(j)%RemSlots = Section(j)%RemSlots - 1
                end if
            end do
        end do

        return
    end subroutine recalculate_available_seats


    subroutine initialize_pre_enlistment(eList)
        type (TYPE_PRE_ENLISTMENT) :: eList
        eList = TYPE_PRE_ENLISTMENT (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1.0)
        return
    end subroutine initialize_pre_enlistment


    subroutine delete_students_of_curriculum_from_enlistment(eList, currIndex)
        type (TYPE_PRE_ENLISTMENT), intent (in out) :: eList(0:)
        integer, intent (in) :: currIndex
        integer :: std
        do std=1,NumStudents
            if (CurrProgCode(Student(std)%CurriculumIdx)/=CurrProgCode(currIndex)) cycle
            call initialize_pre_enlistment(eList(std))
        end do
        return
    end subroutine delete_students_of_curriculum_from_enlistment


    subroutine xml_write_pre_enlistment(path, basename, eList, Section, curriculumFilter)
        character (len=*), intent (in) :: path, basename ! YEAR/TERM/(ENLISTMENT,PREDICTION,WAIVER-COI)
        type (TYPE_PRE_ENLISTMENT), intent(in) :: eList(0:)
        type (TYPE_SECTION), intent(in), dimension (0:) :: Section
        integer, intent (in), optional :: curriculumFilter

        integer :: std, sect, i, lenRecord, filter

        ! training only?
        if (noWrites) return

        if (present(curriculumFilter)) then
            filter = curriculumFilter
        else
            filter = 0
        end if

        ! generate file name
        fileName = trim(dirXML)//trim(path)//basename
        if (filter>0) then
            fileName = trim(fileName)//DASH//trim(CurrProgCode(filter))//'.XML'
        else
            fileName = trim(fileName)//'.XML'
        end if

        ! make backup & open new file
        call move_to_backup(fileName)
        call xml_open_file(unitNo, XML_ROOT_ENLISTMENT, fileName, i)
        write(unitNo,AFORMAT) &
        '    <comment>', &
        '        Generated by '//PROGNAME//VERSION//' on '//currentDate(1:4)// &
                    FSLASH//currentDate(5:6)//FSLASH//currentDate(7:8), &
        '        UnitsEarned       : Units earned in curriculum', &
        '        StdClassification : Student classification (25% rule) - 1=FRESHMAN, 2=SOPHOMORE, 3=JUNIOR, 4=SENIOR', &
        '        StdYear           : Year level in curriculum - 1=FIRST, 2=SECOND, 3=THIRD, 4=FOURTH, 5=FIFTH', &
        '        AllowedLoad       : Units to enlist based on year+term level in curriculum', &
        '        StdPriority       : (see below)', &
        '        NPriority         : No. of priority subjects', &
        '        NAlternates       : No. of alternate subjects', &
        '        NCurrent          : No. of subjects currently registered', &
        '        Enlisted          : Enlisted section', &
        '        Allowed           : Subject with satisfied prerequisite', &
        '        Predicted         : Allowed subject that contributes to demand', &
        '        StdPriority=0     : Manually enlisted ("special-treatment" students)', &
        '        StdPriority=1     : New Student (no record of any grade)', &
        '        StdPriority=2     : Graduating (24 units or less left, no remaining subjects w/ unsatisfied prereqs)', &
        '        StdPriority=3     : Did not fail any subject last sem, or on LOA last sem', &
        '        StdPriority=4     : Failed (0-50%] of units last sem', &
        '        StdPriority=5     : Failed (50%,75%] of units', &
        '        StdPriority=6     : Failed (75%-100%] of units last sem', &
        '        StdPriority=7     : (reserved)', &
        '        StdPriority=8     : (reserved)', &
        '        StdPriority=9     : Subjects not offered, or prerequisites not satisfied', &
        '        StdPriority=10    : Curricular program completed?', &
        '    </comment>'

        do std=1,NumStudents
            ! skip student with no record
            lenRecord = max(eList(std)%lenSubject, eList(std)%NPriority+eList(std)%NAlternates+eList(std)%NCurrent)
            if (lenRecord==0) cycle
            ! skip student if curriculum does not match filter
            if (filter>0) then
                if (CurrProgCode(filter)/=CurrProgCode(Student(std)%CurriculumIdx)) cycle
            end if

            ! student info start
            call xml_write_character(unitNo, indent0, 'Student')
            call xml_write_character(unitNo, indent1, 'StdNo', Student(std)%StdNo)
            call xml_write_integer  (unitNo, indent1, 'UnitsEarned', eList(std)%UnitsEarned)
            call xml_write_integer  (unitNo, indent1, 'StdYear', eList(std)%StdYear)
            call xml_write_integer  (unitNo, indent1, 'StdClassification', eList(std)%StdClassification)
            call xml_write_integer  (unitNo, indent1, 'AllowedLoad', eList(std)%AllowedLoad)
            call xml_write_integer  (unitNo, indent1, 'StdPriority', eList(std)%StdPriority)
            call xml_write_integer  (unitNo, indent1, 'NPriority', eList(std)%NPriority)
            if (eList(std)%NAlternates/=0) &
            call xml_write_integer  (unitNo, indent1, 'NAlternates', eList(std)%NAlternates)
            if (eList(std)%NCurrent/=0) &
            call xml_write_integer  (unitNo, indent1, 'NCurrent', eList(std)%NCurrent)

            do i=1,lenRecord
                sect = eList(std)%Section(i)
                if (sect>0) then
                    call xml_write_character(unitNo, indent1, 'Enlisted', Section(sect)%ClassId)
                elseif (eList(std)%Subject(i)>0) then
                    if (eList(std)%Contrib(i)>0.0) then
                        call xml_write_character(unitNo, indent1, 'Predicted', &
                            trim(Subject(eList(std)%Subject(i))%Name)//COMMA//ftoa(eList(std)%Contrib(i),5) )
                    else
                        call xml_write_character(unitNo, indent1, 'Allowed', Subject(eList(std)%Subject(i))%Name)
                    end if
                end if
            end do
            ! student info end
            call xml_write_character(unitNo, indent0, '/Student')
        end do

        ! close file
        call xml_close_file(unitNo, XML_ROOT_ENLISTMENT)

        return
    end subroutine xml_write_pre_enlistment


    subroutine xml_read_pre_enlistment(path, basename, NumSections, Section, eList, numEntries, errNo, openQuietly)

        character(len=*), intent(in) :: path, basename
        integer, intent (in) :: NumSections
        type (TYPE_SECTION), intent(in), dimension (0:) :: Section
        type (TYPE_PRE_ENLISTMENT), intent(in out) :: eList(0:)
        integer, intent (out) :: numEntries, errNo
        logical, optional, intent(in) :: openQuietly

        character(len=MAX_LEN_XML_LINE) :: value
        character(len=MAX_LEN_XML_TAG) :: tag
        type(TYPE_PRE_ENLISTMENT) :: wrk
        character (len=MAX_LEN_SUBJECT_CODE) :: tSubject
        character (len=MAX_LEN_CLASS_ID) :: tClass
        character (len=MAX_LEN_STUDENT_CODE) :: tStdNo
        integer :: cdx, idx, sdx, std
        logical :: quiet

        if (present(openQuietly)) then
            quiet = openQuietly
        else
            quiet = .false.
        end if

        numEntries = 0
        ! open file, return on any error
        fileName = trim(dirXML)//trim(path)//trim(basename)//'.XML'
        call xml_open_file(unitNo, XML_ROOT_ENLISTMENT, fileName, errNo, forReading, quiet)
        if (errNo/=0) return

        ! examine the file line by line
        do
            read(unitNo, AFORMAT, iostat=eof) line
            if (eof<0) exit

            ! get tag and value if any; exit on any error
            call xml_parse_line(line, tag, value, eof)
            if (eof/=0) exit

            select case (trim(tag))

                case ('Student') ! initialize temporary college data
                    call initialize_pre_enlistment (wrk)

                case ('StdNo')
                    tStdNo = adjustl(value)
                    std = index_to_student(tStdNo)

                case ('UnitsEarned')
                    wrk%UnitsEarned = atoi(value)

                case ('StdYear')
                    wrk%StdYear = atoi(value)

                case ('StdClassification')
                    wrk%StdClassification = atoi(value)

                case ('AllowedLoad')
                    wrk%AllowedLoad = atoi(value)

                case ('StdPriority')
                    wrk%StdPriority = atoi(value)

                case ('NPriority')
                    wrk%NPriority = atoi(value)

                case ('NAlternates')
                    wrk%NAlternates = atoi(value)

                case ('NCurrent')
                    wrk%NCurrent = atoi(value)

                case ('Enlisted')
                    tClass = adjustl(value)
                    sdx = index_to_section(tClass, NumSections, Section)
                    if (sdx==0) then ! invalid class; attempt to extract subject
                        sdx = len_trim(tClass)
                        do while (sdx>1 .and. tClass(sdx:sdx)/=SPACE)
                            sdx = sdx-1
                        end do
                        tSubject = tClass(:sdx)
                        cdx = index_to_subject(tSubject)
                        if (cdx<=0) then ! subject code not found
                            call file_log_message ('No such class; ignored - '//tClass)
                            cycle
                        end if
                        ! add as subject
                        call check_array_bound (wrk%lenSubject, MAX_SUBJECTS_PER_TERM, 'MAX_SUBJECTS_PER_TERM')
                        wrk%lenSubject = wrk%lenSubject + 1
                        wrk%Subject(wrk%lenSubject) = cdx
                    else ! add as section
                        call check_array_bound (wrk%lenSubject, MAX_SUBJECTS_PER_TERM, 'MAX_SUBJECTS_PER_TERM')
                        wrk%lenSubject = wrk%lenSubject + 1
                        wrk%Section(wrk%lenSubject) = sdx
                        wrk%Subject(wrk%lenSubject) = Section(sdx)%SubjectIdx
                        wrk%Grade(wrk%lenSubject) = gdxREGD
                    end if

                case ('Predicted')
                    idx = index(value, COMMA)
                    tSubject = adjustl(value(:idx-1))
                    cdx = index_to_subject(tSubject)
                    if (cdx<=0) then ! subject code not found
                        call file_log_message ('No such subject; ignored - '//tSubject)
                        cycle
                    end if
                    ! add as predicted subject
                    call check_array_bound (wrk%lenSubject, MAX_SUBJECTS_PER_TERM, 'MAX_SUBJECTS_PER_TERM')
                    wrk%lenSubject = wrk%lenSubject + 1
                    wrk%Subject(wrk%lenSubject) = cdx
                    wrk%Contrib(wrk%lenSubject) = atof( trim( value(idx+1:) ) )

                case ('Allowed')
                    tSubject = adjustl(value)
                    cdx = index_to_subject(tSubject)
                    if (cdx<=0) then ! subject code not found
                        call file_log_message ('No such subject; ignored - '//tSubject)
                        cycle
                    end if
                    ! add as allowed subject
                    call check_array_bound (wrk%lenSubject, MAX_SUBJECTS_PER_TERM, 'MAX_SUBJECTS_PER_TERM')
                    wrk%lenSubject = wrk%lenSubject + 1
                    wrk%Subject(wrk%lenSubject) = cdx
                    wrk%Contrib(wrk%lenSubject) = 0.0

                case ('/Student')
                    if (std/=0) then
                        eList(std) = wrk
                        numEntries = numEntries+1
                    else
                        call file_log_message ('No such student; ignored - '//tStdNo)
                    end if

                case default ! do nothing

            end select

        end do

        call xml_close_file(unitNo)
        !call file_log_message (itoa(numEntries)//' in '//fileName)

        return
    end subroutine xml_read_pre_enlistment


    subroutine read_pre_enlistment(path, basename, firstGrp, lastGrp, NumSections, Section, eList, numEntries, errNo)

        character(len=*), intent(in) :: path, basename ! YEAR/TERM/(ENLISTMENT,PREDICTION)
        integer, intent (in) :: firstGrp, lastGrp, NumSections
        type (TYPE_SECTION), intent(in out), dimension (0:) :: Section
        type (TYPE_PRE_ENLISTMENT), intent(out) :: eList(0:)
        integer, intent (in out) :: numEntries
        integer, intent (out) :: errNo

        integer :: grp, mainEntries, partialEntries, ierr
        logical :: noXML

        errNo = 0 ! OK if there's no enlistment record

        ! try the monolithic XML file
        call xml_read_pre_enlistment(path, basename, NumSections, Section, eList, numEntries, ierr)
        noXML = numEntries==0
        mainEntries = numEntries
        if (noXML) then
            ! try each priority group
            do grp=firstGrp,lastGrp
                call xml_read_pre_enlistment(path, trim(basename)//DASH//itoa(grp), NumSections, Section, eList, &
                    partialEntries, ierr, QUIETLY)
                numEntries = numEntries + partialEntries
                if (partialEntries>0) then ! not empty; move to backup
                    call move_to_backup(trim(dirXML)//trim(path)//trim(basename)//DASH//itoa(grp))
                end if
            end do
        end if
        if (noXML .and. numEntries==0) then ! no XML entries
            call custom_read_pre_enlistment(path, basename, NumSections, Section, eList, numEntries, ierr)
            if (numEntries==0) then
                ! try each priority group
                do grp=firstGrp,lastGrp
                    call custom_read_pre_enlistment(path, trim(basename)//DASH//itoa(grp), NumSections, Section, eList, &
                        partialEntries, ierr)
                    numEntries = numEntries + partialEntries
                end do
            end if
        end if

        if (numEntries>mainEntries) then ! write the XML enlistment file?
            call xml_write_pre_enlistment(path, basename, eList, Section)
        end if

        return
    end subroutine read_pre_enlistment


    subroutine custom_read_pre_enlistment(path, basename, NumSections, Section, cList, numEntries, ier)
        character(len=*), intent(in) :: path, basename
        type (TYPE_SECTION), intent(in out), dimension (0:) :: Section
        type (TYPE_PRE_ENLISTMENT), intent(out) :: cList(0:)
        integer, intent (in) :: NumSections
        integer, intent (out) :: numEntries, ier

        integer :: std
        character (len=MAX_LEN_STUDENT_CODE) :: tStdNo
        character (len=MAX_LEN_CURRICULUM_CODE) :: tCurriculum

        numEntries = 0
        fileName = trim(dirRAW)//trim(path)//basename
        open(unit=unitNo, file=fileName, form='formatted', status='old', iostat=ier)
        if (ier/=0) return

        call file_log_message ('Retrieving '//fileName)
        loop_WRITEIN  : &
        do
            read (unitNo, AFORMAT, iostat = eof) line
            if (eof<0) exit loop_WRITEIN
            if (line(1:1)=='#' .or. line(1:3)=='   ') cycle loop_WRITEIN

            call index_to_delimiters(COMMA, line, ndels, pos)
            tStdNo = line(1:pos(2)-1)
            std = index_to_student(tStdNo)
            ! get updated curriculum
            tCurriculum = line(pos(5)+1:pos(6)-1)
            Student(std)%CurriculumIdx = abs(index_to_curriculum(tCurriculum))
            ! retrieve rest of record
            call GetEnlistment(unitNo, NumSections, Section, line, cList(0))
            if (std==0) then
                !call file_log_message('Student not in list: '//line)
                cycle loop_WRITEIN
            else if (cList(0)%lenSubject<0) then
                ier = 1
                exit loop_WRITEIN
            end if

            ! student is in list
            numEntries = numEntries + 1
            cList(std) = cList(0)

        end do loop_WRITEIN
        close(unitNo)
        call file_log_message (itoa(numEntries)//' in '//fileName)

        return
    end subroutine custom_read_pre_enlistment



    subroutine GetEnlistment(iUnit, NumSections, Section, header, preRegistered)
        integer, intent(in) :: iUnit
        type (TYPE_SECTION), intent(in), dimension (0:) :: Section
        integer, intent (in) :: NumSections
        character(len=127), intent(in) :: header
        type (TYPE_PRE_ENLISTMENT), intent (out) :: preRegistered

        integer :: cdx, gdx, k, ndels, pos(30), sdx
        character (len=4) :: tGrade
        character (len=MAX_LEN_SUBJECT_CODE) :: tSubject
        character (len=MAX_LEN_CLASS_ID) :: tSection
        character(len=255) :: line

        call initialize_pre_enlistment(preRegistered)
        !
        !1977-92165,2010,FIRST,CED 291,VW,2,REGD
        !1977-92165,2010,FIRST,CED 299,CD,1,REGD
        !1977-92165,2010,FIRST,DM 220,WY,3,REGD
        !1         2     3    4      5  6 7
        ! Line 1: STDNO,NAME,GENDER,COUNTRY,CURRICULUM,SCHOLAR,COLLEGE,EARNED,CLASSIF,YEARLEVEL,ALLOWED,GROUP,NPRIORITY,NALTERNATES,NCURRENT
        !        1     2    3      4       5          6       7       8      9       10       11      12     13        14          15


        call index_to_delimiters(COMMA, header, ndels, pos)
        if (ndels<=8) then ! old format: signal error
            preRegistered%lenSubject = -1
            return
        !elseif (ndels<=12) then
        !  preRegistered%AllowedLoad = atoi(header(pos(7)+1:pos(8)-1))
        !  preRegistered%StdPriority = atoi(header(pos(8)+1:pos(9)-1))
        !  preRegistered%NPriority = atoi(header(pos(9)+1:pos(10)-1))
        !  preRegistered%NAlternates = atoi(header(pos(10)+1:pos(11)-1))
        !  preRegistered%NCurrent = atoi(header(pos(11)+1:pos(12)-1))
        else
            preRegistered%UnitsEarned = atoi(header(pos(8)+1:pos(9)-1))
            preRegistered%StdClassification = atoi(header(pos(9)+1:pos(10)-1))
            preRegistered%StdYear = atoi(header(pos(10)+1:pos(11)-1))
            preRegistered%AllowedLoad = atoi(header(pos(11)+1:pos(12)-1))
            preRegistered%StdPriority = atoi(header(pos(12)+1:pos(13)-1))
            preRegistered%NPriority = atoi(header(pos(13)+1:pos(14)-1))
            preRegistered%NAlternates = atoi(header(pos(14)+1:pos(15)-1))
            preRegistered%NCurrent = atoi(header(pos(15)+1:pos(16)-1))
        end if
        preRegistered%lenSubject = preRegistered%NPriority+preRegistered%NAlternates+preRegistered%NCurrent
        !write(*,*) trim(header), ', expected entries = ', preRegistered%lenSubject
        do k=1,preRegistered%lenSubject
            read (iUnit, AFORMAT) line

            !write(*,*) k, trim(line)

            call index_to_delimiters(COMMA, line, ndels, pos)
            ! Line 2: STDNO,YEAR,TERM,COURSE,SECTION,UNITS,GRADE,COURSERANK,CONTRIB
            !        1     2    3    4      5       6     7     8          9       10
            ! subject
            tSubject = line(pos(4)+1:pos(5)-1)
            cdx = index_to_subject(tSubject)
            !write(*,*) k, tSubject, cdx
            if (cdx<=0) cycle
            call check_array_bound (k, MAX_SUBJECTS_PER_TERM, 'MAX_SUBJECTS_PER_TERM')
            preRegistered%Subject(k) = cdx
            ! section
            tSection = adjustl(line(pos(5)+1:pos(6)-1))
            if (tSection=='') then ! not accommodated
                sdx = 0
            else
                tSection = trim(tSubject)//SPACE//tSection
                sdx = index_to_section(tSection, NumSections, Section)
                if (sdx==0) then
                    call file_log_message ('No such class; ignored - '//line)
                end if
            end if
            preRegistered%Section(k) = sdx
            ! grade
            tGrade = line(pos(7)+1:pos(8)-1)
            if (tGrade=='') then ! not forced
                gdx = 0
            else
                gdx = index_to_grade(tGrade)
                if (gdx<0) then
                    call file_log_message ('Invalid grade - '//line)
                    gdx = gdxREGD
                end if
            end if
            preRegistered%Grade(k) = gdx
            ! contribution to demand
            if (ndels>8) then
                tSubject = line(pos(9)+1:pos(10)-1)
                read(tSubject,'(f6.4)') preRegistered%Contrib(k)
            end if
        end do
        return
    end subroutine GetEnlistment


    subroutine read_predictions(path, NumSections, Section, eList, numEntries, errNo)

        character(len=*), intent(in) :: path ! YEAR/TERM/
        integer, intent (in) :: NumSections
        type (TYPE_SECTION), intent(in out), dimension (0:) :: Section
        type (TYPE_PRE_ENLISTMENT), intent(out) :: eList(0:)
        integer, intent (in out) :: numEntries
        integer, intent (out) :: errNo

        integer :: mainEntries, partialEntries, ierr
        logical :: noXML

        errNo = 0 ! OK if there's no enlistment record

        ! try the monolithic XML file
        call xml_read_pre_enlistment(path, 'PREDICTIONS', NumSections, Section, eList, numEntries, ierr)
        noXML = numEntries==0
        mainEntries = numEntries
        if (noXML) then ! try the custom format
            call custom_read_pre_enlistment(path, 'PREDICTIONS', NumSections, Section, eList, numEntries, ierr)
            call custom_read_pre_enlistment(path, 'NF-PREDICTIONS', NumSections, Section, eList, partialEntries, ierr)
            numEntries = numEntries + partialEntries
        end if

        if (numEntries>mainEntries) then ! write the XML enlistment file?
            call xml_write_pre_enlistment(path, 'PREDICTIONS', eList, Section)
        end if

        return
    end subroutine read_predictions


end module PRE_ENLISTMENT
